#light
namespace FSharp.WebTools
#nowarn "57"

open System
open System.CodeDom
open System.Reflection
open System.Web.UI
open Microsoft.FSharp.Idioms
open Microsoft.FSharp.Core
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Raw

(*-----------------------------------------------------------------------------------------------*)
module Fix = begin
(*-----------------------------------------------------------------------------------------------*)
// Don't ask me why I have 3 same things here.. it doesn't matter because it is sooo ugly anyway

  /// Tests whether expression is call to method/constructor of class declared in F#
  /// If so returns all the information (type, operation name, 
  /// operation arity) and arguments is returned
  let (|FSharpClassInvoke|_|) x =
    match x with
    | App _ -> 
        let (op,args) = (|Apps|) x in 
        (match op with  
          | AnyTopDefnUse (def, _) ->
            // test wether Apps is call to F# class
            let (path, name) = def.Path in
            let opParts = name.Split(Array.create 1 '.') in
            if (opParts.Length <> 3) then None else 
              ( // get the System.Type of the invoked class
              let ns = (List.fold_left (fun st el -> (st^el^".") ) "" path)
              let cln1 = ns + (opParts.(0)) in
              let cln2 = ns.Replace(".Async.", ".AsyncModule+").Replace(".Core.", ".Core+") + (opParts.(0)) in
              
              let opName = opParts.(1) in let opArity = Int32.Parse(opParts.(2)) in
              (match Type.GetType(cln1^", "^(def.Assembly.FullName)) with
                | null -> 
                    (match Type.GetType(cln2^", "^(def.Assembly.FullName)) with
                      | null -> None
                      | typ -> Some ((typ, opName, opArity), args))
                | typ -> Some ((typ, opName, opArity), args)) )
          | _ -> None ); 
    | _ -> None  
    
  let methReg = new Text.RegularExpressions.Regex("^(?<cls>[`a-zA-Z0-9_]+)\.(?<meth>[a-zA-Z0-9_]+)\.(?<art>[0-9]+)$")
  let (|MethodCall|_|) x =
    match x with
    | Raw.MethodCall v -> Some v;
    | Raw.App _ -> 
        ( let (op,args) = (|Apps|) x in
        (match op with 
          | Raw.AnyTopDefnUse (a,_) -> 
              let (opPath, op) = a.Path in
              let m = methReg.Match(op) in
              if (m.Success) then (
                let ns = (List.fold_left (fun st el -> (st^el^".") ) "" opPath)
                let cln1 = ns + (m.Groups.get_Item("cls").Value) in
                let cln2 = ns.Replace(".Async.", ".AsyncModule+").Replace(".Core.", ".Core+") + (m.Groups.get_Item("cls").Value) in
                
                let ty = 
                  let ty1 = a.Assembly.GetType(cln1)
                  if (ty1 = null) then a.Assembly.GetType(cln2) else ty1
                if (ty = null) then failwithf "Class %s or maybe %s not found in assembly %s" cln1 cln2 a.Assembly.FullName
                
                let arity = Int32.Parse(m.Groups.get_Item("art").Value) in
                let meth = ty.GetMethods() |> Array.filter ( fun meth -> 
                  meth.Name = (m.Groups.get_Item("meth").Value) (*&& meth.GetParameters().Length = arity*) ) in
                if (meth.Length = 0) then 
                  None
                else
                  Some (meth.[0], args);
              ) else None;
          | _ -> None; ) )    
    | _ -> None
          
  let (|PropSetOrGet|_|) ext x = 
    match x with
    | Raw.App _ -> 
        ( let (op,args) = (|Apps|) x in
        (match op with 
          | Raw.AnyTopDefnUse (a,_) -> 
              let (opPath, op) = a.Path in
              if (op.EndsWith(ext)) then (
                let opParts = op.Split(Array.create 1 '.') in
                let ns = (List.fold_left (fun st el -> (st^el^".") ) "" opPath)
                let cln1 = ns + (opParts.[0]) in
                let cln2 = ns.Replace(".Async.", ".AsyncModule+").Replace(".Core.", ".Core+") + (opParts.[0]) in // slightly ad-hoc case:-)
                
                let ty = 
                  let ty1 = a.Assembly.GetType(cln1)
                  if (ty1 = null) then a.Assembly.GetType(cln2) else ty1
                if (ty = null) then failwithf "Class %s or maybe %s not found in assembly %s" cln1 cln2 a.Assembly.FullName
                
                // One more --- !
                let prop = ty.GetProperties() |> Array.to_seq |> Seq.filter ( fun prop -> 
                  prop.Name = (opParts.[1]) ) |> Seq.hd in
                                    
                Some (prop, args)
              ) else None;
          | _ -> None; ) )    
    | _ -> None

  let (|CtorCall|_|) x =
    match x with
    | Raw.CtorCall (meth,args) -> 
        Some(meth, args)
    | FSharpClassInvoke ((typ,"new",arity), args) ->  
        // TODO: check whether class is "[<ClientSideClass>]" or sth like that, check number of parameters
        match
          (typ.GetConstructors()
          |> Seq.first ( fun ct -> if (ct.GetParameters().Length = arity) then Some ct else None )) with
        | Some ctor -> Some(ctor, args)
        | _ -> failwith "Can't find constructor!"
    | _ -> None
    
  let (|PropGet|_|) x = 
    match x with 
    | Raw.PropGet (p, args) -> Some (p, [args])
    | PropSetOrGet "get.1" p -> Some p // instance
    | PropSetOrGet "get.0" p -> Some p // static
    | _ -> None
    
  let (|PropSet|_|) x = 
    match x with 
    | MethodCall (m, args) -> 
        try
          if (m.Name.StartsWith("set_")) then 
            Some (m.DeclaringType.GetProperty(m.Name.Substring(4, m.Name.Length-4)), args)
          else None
        with _ -> None // ambigous match...
    | PropSetOrGet "set.2" p -> Some p
    | _ -> None
    
end

(*-----------------------------------------------------------------------------------------------*)
module Quotations = begin
(*-----------------------------------------------------------------------------------------------*)
// Extended Expr type - this type is used because we sometimes need to encode a few more
// things that can be directly done by F# expressions (for example some untyped JS code)

  type ScriptExpr = 
    | ValueRef of string
    | Embedded of string
    | FieldSet of (ExtendedExpr * string * ExtendedExpr)
    | Seq of (ExtendedExpr list)
    | Lambda of (ExprVar list * ExtendedExpr)
    | Unresolved
    
  and ExtendedExpr =
    | StdExprValue of Expr
    | ExtExprValue of ScriptExpr

  /// Pattern for matching standard expr type
  let (|StdExpr|_|) e = match e with | StdExprValue v -> Some v | _ -> None;
  /// Pattern for matching extended (script) expr type
  let (|ExtExpr|_|) e = match e with | ExtExprValue v -> Some v | _ -> None;

  let (|ScriptValueRef|_|)    = function | ExtExprValue(ValueRef v) -> Some v   | _ -> None
  let (|ScriptEmbedded|_|)    = function | ExtExprValue(Embedded v) -> Some v   | _ -> None
  let (|ScriptFieldSet|_|)    = function | ExtExprValue(FieldSet v) -> Some v   | _ -> None
  let (|ScriptSeq|_|)         = function | ExtExprValue(Seq      v) -> Some v   | _ -> None
  let (|ScriptLambda|_|)      = function | ExtExprValue(Lambda   v) -> Some v   | _ -> None
  let (|ScriptUnresolved|_|)  = function | ExtExprValue(Unresolved) -> Some ()  | _ -> None
  
  let MkStdExprOption e = match e with None -> None | Some e -> Some (StdExprValue e)
  let MkStdExpr e = StdExprValue e
  let MkExtExpr e = ExtExprValue e

  // Constructors for extended expressions  
  let MkEmbeddedExpr s = ExtExprValue (Embedded s)
  let MkFieldSet v     = ExtExprValue (FieldSet v)
  let MkValueRef v     = ExtExprValue (ValueRef v)
  let MkExtSeqExpr v   = ExtExprValue (Seq v)
  let MkExtLambda v    = ExtExprValue (Lambda v)
  let MkUnresolved ()  = ExtExprValue (Unresolved)

(*-----------------------------------------------------------------------------------------------*)
// Types, patterns and functions for working with classes

  [<Flags>]
  type FieldOptions =
    | None = 0
    |  Static = 1

  [<Flags>]
  type MemberOptions =
    | None = 0
    | Static = 1
    | Virtual = 2
    | Overridden = 6
    | Abstract = 8

  type ClassMember =
    | ConstructorMember of (MemberInfo*ExtendedExpr)
    | MethodMember of (MemberInfo*MemberOptions*string*ExtendedExpr*Type option)
    | PropertyMember of (MemberInfo*MemberOptions*string*ExtendedExpr option*ExtendedExpr option*Type)
    | FieldMember of (MemberInfo*FieldOptions*string*Type*ExtendedExpr option)

  let (|Constructor|_|) = function | ConstructorMember v -> Some v | _ -> None
  let (|Method|_|) = function | MethodMember v -> Some v | _ -> None
  let (|Field|_|) = function | FieldMember v -> Some v | _ -> None
  let (|Property|_|) = function | PropertyMember v -> Some v | _ -> None

  let MkConstructor (a,b) = ConstructorMember ((a:>MemberInfo),b)
  let MkMethod (a,b,c,d,e) = MethodMember ((a:>MemberInfo),b,c,d,e)
  let MkField (a,b,c,d,e) = FieldMember ((a:>MemberInfo),b,c,d,e)
  let MkProperty (a,b,c,d,e,f) = PropertyMember ((a:>MemberInfo),b,c,d,e,f)
  
  type ClassInfo = 
    { name:string;
      baseName:string option;
      members:ClassMember list; } 
    with 
      member x.Name = x.name;
      member x.BaseName = x.baseName;
      member x.Members = x.members;
    end
    
  let MkClassInfo n b m =  { name=n; baseName=b; members=m; }
  
end